F.I.G. Forth

* FIG FORTH FOR SERIES-16 MACHINES PAGE 17

0648 ****************************************************************** 0649 * 0650 * CHARACTER HANDLING 0651 * 0652 ****************************************************************** 0653 00166 0 000000 CHGT DAC ** GET CHARACTER AT ADDRESS 0654 00167 0404 77 LGR 1 LS BIT GOES TO CARRY 0655 00170 0 04 00111 STA CADR SAVE WORD ADDRESS 0656 00171 -0 02 00111 LDA* CADR LOAD THROUGH IT 0657 00172 101001 SSC 0658 00173 0404 70 LGR 8 FIRST BYTE IN UPPER BYTE 0659 00174 0 03 00735 ANA ='377 LOSE UPPER BYTE 0660 00175 -0 01 00166 JMP* CHGT 0661 * 0662 00176 0 000000 CHPT DAC ** PUT CHARACTER IN B TO CHARACTER ADDRESS 0663 00177 0404 77 LGR 1 LS BIT GOES TO CARRY 0664 00200 0 04 00111 STA CADR SAVE WORD ADDRESS 0665 00201 101001 SSC 0666 00202 0 01 00212 JMP CHPU 0667 * 0668 * PLACE IN LOWER BYTE 0669 00203 000201 IAB GET CHARACTER BACK 0670 00204 0 03 00735 ANA ='377 LOSE UPPER BYTE IF ANY 0671 00205 -0 13 00111 IMA* CADR GET EXISTING WORD 0672 00206 0 03 00734 ANA ='177400 DISCARD LOWER BYTE 0673 00207 -0 05 00111 CHP1 ERA* CADR 0674 00210 -0 04 00111 STA* CADR 0675 00211 -0 01 00176 JMP* CHPT 0676 * 0677 * PLACE IN UPPER BYTE 0678 00212 000201 CHPU IAB GET CHARACTER BACK 0679 00213 0 03 00735 ANA ='377 LOSE UPPER BYTE IF ANY 0680 00214 0414 70 LGL 8 GET INTO UPPER BYTE 0681 00215 -0 13 00111 IMA* CADR GET EXISTING WORD 0682 00216 0 03 00735 ANA ='377 DISCARD UPPER BYTE 0683 00217 0 01 00207 JMP CHP1 0684 EJCT