Previous Page Single Page Next Page  

* FIG FORTH FOR SERIES-16 MACHINES PAGE 26

1037 * **** I **** 1038 * RETURN CURRENT LOOP COUNTER TO THE STACK 1039 * HEAD FNUL,I,I 1040 000377 TLNK SET * 1041 00377 000511 VFD 1,0,1,FNUL,6,1,8,'111 1042 * =<FNUL,1>,'I' 1043 00400 0 000366 DAC LINK 1044 000377 LINK SET TLNK 1045 000401 I EQU * 1046 00401 -0 02 00101 LDA* RP 1047 00402 0 01 00116 JMP PUSH 1048 * 1049 * **** DIGIT **** 1050 * USED BY THE COMPILER 1051 * (ASCII-DIGIT BASE ==> DIGIT-VALUE TRUE(OR FALSE)) 1052 * HEAD FNUL,DIGIT,DIGT 1053 000403 TLNK SET * 1054 00403 002704 VFD 1,0,1,FNUL,6,5,8,'304 1055 * =<FNUL,5>,'D' 1056 00404 144707 BCI 1,IG 1057 00405 144524 VFD 8,'311,8,'124 ='IT' 1058 00406 0 000377 DAC LINK 1059 000403 LINK SET TLNK 1060 000407 DIGT EQU * 1061 00407 1 02 00002 LDA 2,1 GET ASCII VALUE 1062 00410 0 07 00424 SUB XZRO 1063 00411 100400 SPL 1064 00412 0 01 00431 JMP DIGX 1065 00413 0 11 00727 CAS =9 1066 00414 0 01 00425 JMP DIGA A>9 1067 00415 101000 NOP A=9 1068 00416 1 11 00001 DIGY CAS 1,1 COMPARE BASE 1069 00417 0 01 00431 JMP DIGX A>BASE 1070 00420 0 01 00431 JMP DIGX A=BASE 1071 00421 1 04 00002 STA 2,1 SAVE DIGIT VALUE 1072 00422 0 02 00736 LDA =1 1073 00423 0 01 00125 JMP PUT 1074 00424 000260 XZRO VFD 16,CZRO 1075 * 1076 00425 0 07 00726 DIGA SUB =7 SUBTRACT 'A'-'0' 1077 00426 0 11 00727 CAS =9 NOW EXPECT TO BE >9 1078 00427 0 01 00416 JMP DIGY A>9 - OK 1079 00430 101000 NOP A=9 1080 00431 140040 DIGX CRA A<9 - ERROR EXIT 1081 00432 0 01 00124 JMP BINA 1082 EJCT
  Previous Page Single Page Next Page